Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Applications/NIH Image 1.62b11/src/Edit.p

Text File | 1996-11-04 | 57KB | 1,927 lines

unit Edit;

{Editing routines used by NIH Image}

interface

    uses
        Types, Memory, QuickDraw, QuickDrawText, Packages, Menus, Events, Fonts,
        Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile, Windows,
        Controls, TextEdit, Files, Dialogs, TextUtils, Finder, MixedMode, Processes,
        globals, Utilities, Graphics, Camera, analysis, file1, filters, stacks, Lut, Text, math;


    procedure FlipOrRotate (DoWhat: FlipRotateType);
    procedure RotateToNewWindow (DoWhat: FlipRotateType);
    procedure Rotate (DoWhat: FlipRotateType);
    procedure DoCopy;
    procedure DoCut;
    procedure DoPaste;
    procedure DoClear;
    procedure ShowClipboard;
    procedure DoObject (obj: ObjectType; event: EventRecord);
    procedure DoSprayCan;
    procedure DoBrush (event: EventRecord);
    procedure DoText (loc: point);
    procedure SetSprayCanSize;
    procedure SetBrushSize;
    procedure SetLineWidth;
    procedure UpdateEditMenu;
    procedure ConverToSystemClipboard;
    procedure ZoomOut;
    procedure ZoomIn (event: EventRecord);
    procedure Scroll (event: EventRecord);
    procedure DoFill (event: EventRecord);
    procedure DoGrow (WhichWindow: WindowPtr; event: EventRecord);
    procedure DrawCharacter (ch: char);
    procedure ConvertFromSystemClipboard;
    procedure SetupOperation (item: integer);
    procedure PastePicture;
    procedure DoUndo;
    procedure FindWhatToCopy;
    procedure CopyResults;


implementation


    procedure PivotSelection (var SelectionRect: rect; WindowRect: rect);
        var
            OldWidth, NewWidth, OldHeight, NewHeight, hCenter, vCenter, NewLeft, NewTop: integer;
    begin
        with SelectionRect do begin
                OldWidth := right - left;
                OldHeight := bottom - top;
                hCenter := left + OldWidth div 2;
                vCenter := top + OldHeight div 2;
            end;
        NewWidth := OldHeight;
        NewHeight := OldWidth;
        NewLeft := hCenter - NewWidth div 2;
        NewTop := vCenter - NewHeight div 2;
        with WindowRect do begin
                if (NewLeft + NewWidth) > right then
                    NewLeft := right - NewWidth;
                if (NewTop + NewHeight) > bottom then
                    NewTop := bottom - NewHeight;
                if NewLeft < 0 then
                    NewLeft := 0;
                if NewTop < 0 then
                    NewTop := 0;
            end;
        with SelectionRect do begin
                left := NewLeft;
                top := NewTop;
                right := NewLeft + NewWidth;
                bottom := NewTop + NewHeight;
            end;
    end;


    procedure FlipLine (var LineBuf: LineType; width: integer);
        var
            TempLine: LineType;
            i, WidthLessOne: integer;
    begin
        TempLine := LineBuf;
        WidthLessOne := width - 1;
        for i := 0 to width - 1 do
            LineBuf[i] := TempLine[WidthLessOne - i];
    end;


    procedure ScreenToOffscreenRect (var r: rect);
        var
            p1, p2: point;
    begin
        with r do begin
                p1.h := left;
                p1.v := top;
                p2.h := right;
                p2.v := bottom;
                ScreenToOffscreen(p1);
                ScreenToOffscreen(p2);
                Pt2Rect(p1, p2, r);
            end;
    end;


    procedure FlipOrRotate (DoWhat: FlipRotateType);
        var
            SaveInfo: InfoPtr;
            width, height, hDst, vSrc, vDst, hSrc, i, inc: integer;
            LineBuf: LineType;
            srect, drect, MaskRect: rect;
            AutoSelectAll: boolean;
            SaveRow:integer;
            NextUpdate: LongInt;

    begin
        if NotRectangular or NotInBounds or NoUndo then
            exit(FlipOrRotate);
        AutoSelectAll := not Info^.RoiShowing;
        if AutoSelectAll then
            SelectAll(true);
        if TooWide then
            exit(FlipOrRotate);
        ShowWatch;
        SetupUndoFromClip;
        SetupUndo;
        if (DoWhat = RotateLeft) or (DoWhat = RotateRight) then
            WhatToUndo := UndoRotate
        else
            WhatToUndo := UndoFlip;
        SetupUndoInfoRec;
        SaveInfo := Info;
        srect := info^.RoiRect;
        case DoWhat of

            RotateLeft, RotateRight:
                with srect do begin
                        if OptionKeyWasDown then
                            DoOperation(EraseOp);
                        drect := srect;
                        with info^ do begin
                                PivotSelection(drect, PicRect);
                                MaskRect := drect;
                                RoiRect := drect;
                                RectRgn(roiRgn, RoiRect);
                            end;
                        width := right - left;
                        if DoWhat = RotateLeft then begin
                                hDst := drect.left;
                                inc := 1
                            end
                        else begin
                                hDst := drect.right - 1;
                                inc := -1
                            end;
                        SaveRow:=top;
                        NextUpdate:=TickCount+6; {10/sec}
                        for vSrc := top to bottom - 1 do begin
                                Info := UndoInfo;
                                GetLine(left, vSrc, width, LineBuf);
                                if DoWhat = RotateLeft then
                                    FlipLine(LineBuf, width);
                                Info := SaveInfo;
                                PutColumn(hDst, drect.top, width, LineBuf);
                                hDst := hDst + inc;
                                if TickCount>=NextUpdate then begin
                                    SetRect(MaskRect, left, SaveRow, left+width, vSrc + 1);
                                    UpdateScreen(MaskRect);
                                    SaveRow:=vSrc+1;
                                    NextUpdate:=TickCount+6;
                                    ShowAnimatedWatch;
                                end;
                            end;
                            SetRect(MaskRect, left, SaveRow, left+width, bottom);
                            UpdateScreen(MaskRect);
                    end;

            FlipVertical:
                with srect do begin
                        width := right - left;
                        vDst := bottom;
                        for vSrc := top to bottom - 1 do begin
                                Info := UndoInfo;
                                GetLine(left, vSrc, width, LineBuf);
                                Info := SaveInfo;
                                vDst := vDst - 1;
                                PutLine(left, vDst, width, LineBuf);
                            end;
                    end;

            FlipHorizontal:
                with srect do begin
                        width := right - left;
                        SaveRow:=top;
                        NextUpdate:=TickCount+6; {10/sec}
                        for vSrc := top to bottom - 1 do begin
                                Info := UndoInfo;
                                GetLine(left, vSrc, width, LineBuf);
                                FlipLine(LineBuf, width);
                                Info := SaveInfo;
                                PutLine(left, vSrc, width, LineBuf);
                                if TickCount>=NextUpdate then begin
                                    SetRect(MaskRect, left, SaveRow, left+width, vSrc + 1);
                                    UpdateScreen(MaskRect);
                                    SaveRow:=vSrc+1;
                                    NextUpdate:=TickCount+6;
                                    ShowAnimatedWatch;
                                end;
                            end;
                            SetRect(MaskRect, left, SaveRow, left+width, bottom);
                            UpdateScreen(MaskRect);
                    end;

        end; {case}
        Info := SaveInfo;
        Info^.changes := true;
        SetupRoiRect;
        if AutoSelectAll then
            KillRoi;
    end;



    procedure RotateToNewWindow (DoWhat: FlipRotateType);
        var
            SrcInfo, DstInfo: InfoPtr;
            Srcwidth, DstWidth, DstHeight, hDst, vSrc, vDst, hSrc, i, inc, ignore: integer;
            LineBuf: LineType;
            SourceRect, DstRect, MaskRect: rect;
            AutoSelectAll, isStack: boolean;
            SaveCol:integer;
            NextUpdate: LongInt;
    begin
        if NotRectangular or NotInBounds then
            exit(RotateToNewWindow);
        AutoSelectAll := not Info^.RoiShowing;
        isStack := info^.StackInfo <> nil;
        if AutoSelectAll then
            SelectAll(true);
        if TooWide then
            exit(RotateToNewWindow);
        ShowWatch;
        SrcInfo := info;
        with info^, info^.RoiRect do begin
                SourceRect := RoiRect;
                SrcWidth := right - left;
                DstWidth := bottom - top;
                DstHeight := right - left;
                if not NewPicWindow(title, DstWidth, DstHeight) then begin
                        KillRoi;
                        AbortMacro;
                        exit(RotateToNewWindow)
                    end;
                DstInfo := info;
                DstRect := info^.PicRect;
            end;
        if DoWhat = RotateLeft then begin
                hDst := 0;
                inc := 1
            end
        else begin
                hDst := DstWidth - 1;
                inc := -1
            end;
        with SourceRect do begin
            SaveCol:=hDst;
            NextUpdate:=TickCount+6; {10/sec}
            for vSrc := top to bottom - 1 do begin
                    Info := SrcInfo;
                    GetLine(left, vSrc, SrcWidth, LineBuf);
                    if DoWhat = RotateLeft then
                        FlipLine(LineBuf, SrcWidth);
                    Info := DstInfo;
                    PutColumn(hDst, 0, SrcWidth, LineBuf);
                    if TickCount>=NextUpdate then begin
                        if DoWhat=RotateLeft
                            then SetRect(MaskRect, SaveCol, 0, hDst+1, SrcWidth)
                            else SetRect(MaskRect, hDst, 0, SaveCol+1, SrcWidth);
                        UpdateScreen(MaskRect);
                        SaveCol:=hDst+1;
                        NextUpdate:=TickCount+6;
                        ShowAnimatedWatch;
                    end;
                    hDst := hDst + inc;
                end; {for}
                if DoWhat=RotateLeft
                    then SetRect(MaskRect, SaveCol, 0, dstWidth, SrcWidth)
                    else SetRect(MaskRect, 0, 0, SaveCol+1, SrcWidth);
                UpdateScreen(MaskRect);
            end; {with}
        info^.changes := true;
        if AutoSelectAll and not isStack then
            with SrcInfo^ do begin
                    Changes := false;
                    ignore := CloseAWindow(wptr);
                    info := DstInfo;
                end;
    end;


    procedure Rotate; {(DoWhat: FlipRotateType)}
        const
            NewWindowID = 3;
        var
            mylog: DialogPtr;
            item: integer;
            NewWindow: boolean;
    begin
        with info^, info^.RoiRect do
            if RoiShowing then
                NewWindow := ((right - left) > PicRect.bottom) or ((bottom - top) > PicRect.right)
            else begin
                    RotateToNewWindow(DoWhat);
                    exit(Rotate);
                end;
        InitCursor;
        mylog := GetNewDialog(120, nil, pointer(-1));
        SetDlogItem(mylog, NewWindowID, ord(NewWindow));
        OutlineButton(MyLog, ok, 16);
        repeat
            if item = NewWindowID then begin
                    NewWindow := not NewWindow;
                    SetDlogItem(mylog, NewWindowID, ord(NewWindow));
                end;
            ModalDialog(nil, item);
        until (item = ok) or (item = cancel);
        DisposeDialog(mylog);
        if item = cancel then
            exit(Rotate);
        if NewWindow then
            RotateToNewWindow(DoWhat)
        else
            FlipOrRotate(DoWhat);
    end;


    function CopyImage: boolean;
        var
            err, width, EvenWidth, height, size: LongInt;
            line: integer;
            ClipXOffset, ClipYOffset: integer;
            SavePort: GrafPtr;
            SaveGDevice: GDHandle;
    begin
        if OpPending then begin
            KillRoi;
            RestoreRoi;
        end;
        with info^, info^.RoiRect do begin
            if (RoiType = RectRoi) and (PictureType = FrameGrabberType) then begin
                {We can't offset an roi copied from Camera window or "live" paste won't work}
                ClipXOffset := 0;
                ClipYOffset := 0;
                width := picRect.right;
                height := picRect.bottom;
            end else begin
                ClipXOffset := left;
                ClipYOffset := top;
                width := right - left;
                height := bottom - top;
            end;
            if odd(width) then
                EvenWidth := width + 1
            else
                EvenWidth := width;
            size := EvenWidth * height;
            if size > ClipBufSize then begin
                PutError(StringOf('This ',size div 1024:1,'K selection is larger than the ',ClipBufSize div 1024:1,'K Clipboard buffer.'));
                WhatsOnClip := NothingOnClip;
                AbortMacro;
                CopyImage := false;
                exit(CopyImage)
            end;
        end;
        with ClipBufInfo^ do begin
            PixelsPerLine := width;
            BytesPerRow := EvenWidth;
            nLines := height;
            RoiRect := info^.RoiRect;
            OffsetRect(RoiRect, -ClipXOffset, -ClipYOffset);
            roiType := Info^.roiType;
            PicRect := RoiRect;
            with osPort^.portPixMap^^ do begin
                    RowBytes := BitOr(BytesPerRow, $8000);
                    bounds := PicRect;
                end;
            with osPort^ do begin
                    PortRect := PicRect;
                    RectRgn(visRgn, PicRect);
                end;
            if RoiType = RectRoi then begin
                if info^.PictureType = FrameGrabberType then
                    WhatsOnClip := CameraPic
                else
                    WhatsOnClip := RectPic
            end else
                WhatsOnClip := NonRectPic;
            SaveGDevice := GetGDevice;
            SetGDevice(osGDevice);
            GetPort(SavePort);
            SetPort(GrafPtr(osPort));
            CopyRgn(info^.roiRgn, roiRgn);
            OffsetRgn(roiRgn, -ClipXOffset, -ClipYOffset);
            ctable := info^.ctable;
            pmForeColor(BlackIndex);
            pmBackColor(WhiteIndex);
            CopyBits(BitMapHandle(Info^.osPort^.portPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, Info^.RoiRect, RoiRect, SrcCopy, nil);
            pmForeColor(ForegroundIndex);
            pmBackColor(BackgroundIndex);
            SetPort(SavePort);
            SetGDevice(SaveGDevice);
        end; {with}
        CopyImage := true;
    end;


    procedure CopyWindow;
        var
            tPort: GrafPtr;
            WindowSize: LongInt;
            WindowRect: rect;
            WhichWindow: WindowPtr;
            kind, ignore: integer;
            HidingPasteControl: boolean;
            SaveGDevice: GDHandle;i:integer;
    begin
        WhichWindow := FrontWindow;
        if WhichWindow = nil then
            exit(CopyWindow);
        WindowRect := WhichWindow^.PortRect;
        kind := WindowPeek(WhichWindow)^.WindowKind;
        HidingPasteControl := false;
        with WindowRect do begin
                WindowSize := right;
                WindowSize := WindowSize * bottom;
            end;
        if kind = LUTKind then
            WindowRect.bottom := 256;
        case kind of
            ProfilePlotKind:  begin
                    ConvertPlotToText;
                    ClipTextInBuffer := true;
                end;
            CalibrationPlotKind:  begin
                    ConvertCalibrationCurveToText;
                    ClipTextInBuffer := true;
                end;
            HistoKind, LUTKind, MapKind, ToolKind:  begin
                    if PasteControl <> nil then begin
                            ignore := CloseAWindow(PasteControl);
                            HidingPasteControl := true;
                        end;
                    case kind of
                        HistoKind:  begin
                                ConvertHistoToText;
                                ClipTextInBuffer := true;
                                DrawHistogram;
                            end;
                        MapKind:
                            DrawMap;
                        LUTKind:
                            DrawLUT;
                        ToolKind:
                            DrawTools;
                    end; {case}
                end;
            otherwise
        end; {case}
        if NoUndo then begin
                WhatsOnClip := NothingOnClip;
                exit(CopyWindow)
            end;
        ClipboardConverted := false;
        with ClipBufInfo^ do begin
                RoiType := RectRoi;
                RoiRect := WindowRect;
                RectRgn(roiRgn, RoiRect);
                PicRect := WindowRect;
                PixelsPerLine := WindowRect.right;
                BytesPerRow := PixelsPerLine;
                if odd(BytesPerRow) then
                    BytesPerRow := BytesPerRow + 1;
                nLines := WindowRect.bottom;
                with osPort^.portPixMap^^ do begin
                        RowBytes := BitOr(BytesPerRow, $8000);
                        bounds := WindowRect;
                    end;
                with osPort^ do begin
                        PortRect := PicRect;
                        RectRgn(visRgn, PicRect);
                        SetRectRgn(ClipRgn, 0, 0, 30000, 30000);
                    end;
                WhatsOnClip := RectPic;
                SaveGDevice := GetGDevice;
                SetGDevice(osGDevice);
                GetPort(tPort);
                SetPort(GrafPtr(osPort));
                RGBForeColor(BlackRGB);
                RGBBackColor(WhiteRGB);
                if (kind = ProfilePlotKind) or (kind = CalibrationPlotKind) then begin
                        EraseRect(osPort^.portRect);
                        DrawPlot
                    end
                else
                    CopyBits(WhichWindow^.PortBits, BitMapHandle(osPort^.portPixMap)^^, WindowRect, WindowRect, SrcCopy, nil);
                SetPort(tPort);
                SetGDevice(SaveGDevice);
            end; {with}
        if HidingPasteControl then
            ShowPasteControl;
    end;


    procedure CopyResults;
        var
            err: OSErr;
    begin
        CopyResultsToBuffer(1, mCount, ShowHeadings);
        UnsavedResults := false;
        err := ZeroScrap;
        if err = NoErr then begin
                err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP));
                WhatsOnClip := NothingOnClip; {The text is on the System Scrap}
            end;
    end;


    procedure DoCopy;
        var
            err: OSErr;
    begin
        err := ZeroScrap;
        OldScrapCount := GetScrapCount;
        case WhatToCopy of
            CopyColor:
                DoCopyColor;
            CopySelection:  begin
                    if not CopyImage then exit(DoCopy);
                    ClipTextInBuffer := false;
                    ClipboardConverted := false;
                end;
            CopyHistogram, CopyPlot, CopyCalibrationPlot, CopyCLUT, CopyGrayMap, CopyTools:
                CopyWindow;
            CopyMeasurements:
                CopyResults;
            CopyText:
                DoTextCopy;
            otherwise
                beep;
        end;
    end;


    procedure DoCut;
    begin
        DoCopy;
        DoClear;
    end;


    procedure CenterRect (inRect, outRect: rect; var ResultRect: rect);
{Creates a new rectangle(ResultsRect) that is the same size as inRect, but centered within outRect.}
        var
            width, height, hcenter, vcenter: integer;
    begin
        with inRect do begin
                width := right - left;
                height := bottom - top;
            end;
        with outRect do begin
                hcenter := left + (right - left) div 2;
                vcenter := top + (bottom - top) div 2;
            end;
        with ResultRect do begin
                left := hcenter - width div 2;
                top := vcenter - height div 2;
                right := left + width;
                bottom := top + height;
            end;
    end;


    procedure PastePicture;
        var
            loc: point;
            SrcWidth, SrcHeight, DstHeight, DstWidth, dh, dv: integer;
            DestRect: rect;
            WindowNotResized: boolean;
    begin
        if LivePasteMode or (PasteTransferMode <> SrcCopy) then begin
                LivePasteMode := false;
                PasteTransferMode := SrcCopy;
                if PasteControl <> nil then
                    DrawPasteControl
            end;
        with info^ do begin
                SetupUndo;
                WhatToUndo := UndoPaste;
                if RoiShowing then
                    with RoiRect do {Pasting back into selection of same size?}
                        if ((right - left) = (ClipBufInfo^.RoiRect.right - ClipBufInfo^.RoiRect.left)) and ((bottom - top) = (ClipBufInfo^.RoiRect.bottom - ClipBufInfo^.RoiRect.top)) and (ClipBufInfo^.RoiType = RoiType) then begin
                                OpPending := true;
                                CurrentOp := PasteOp;
                                exit(PastePicture)
                            end;
                with ClipBufInfo^.RoiRect do {Pasting into same size window?}
                    if (PicRect.right = right - left) and (PicRect.bottom = (bottom - top)) and (ClipBufInfo^.RoiType = RectRoi) then begin
                            SelectAll(true);
                            WhatToUndo := UndoPaste;
                            OpPending := true;
                            CurrentOp := PasteOp;
                            exit(PastePicture)
                        end;
                if RoiShowing or (roiType <> NoRoi) then
                    KillRoi;
                with ClipBufInfo^.RoiRect do begin
                        SrcWidth := right - left;
                        SrcHeight := bottom - top;
                    end;
                with SrcRect do begin
                        DstWidth := right - left;
                        DstHeight := bottom - top;
                    end;
                with initwrect do
                    WindowNotResized := (DstWidth = (right - left)) and (DstHeight = (bottom - top));
                if ((SrcWidth > DstWidth) or (SrcHeight > DstHeight)) and WindowNotResized then
                    DestRect := PicRect
                else
                    DestRect := SrcRect;
                CenterRect(ClipBufInfo^.RoiRect, DestRect, RoiRect);
                roiType := ClipBufInfo^.roiType;
                CopyRgn(ClipBufInfo^.roiRgn, roiRgn);
                dh := RoiRect.left - roiRgn^^.rgnbbox.left;
                dv := RoiRect.top - roiRgn^^.rgnbbox.top;
                OffsetRgn(roiRgn, dh, dv);
                RoiShowing := true;
                OpPending := true;
                CurrentOp := PasteOp;
                BinaryPic := false;
            end;{with}
    end;


    procedure ConvertFromSystemClipboard;
  {Converts system-wide clipboard to local clipboard.}
    var
        phandle: handle;
        offset, length, size, EvenWidth: LongInt;
        pframe: rect;
        width, height: LongInt;
        tPort: GrafPtr;
        ScrapInfo: ScrapStuffPtr;
        SaveGDevice: GDHandle;
    begin
        ScrapInfo := InfoScrap;
        if ScrapInfo^.ScrapSize <= 0 then
            exit(ConvertFromSystemClipboard);
        phandle := NewHandle(0);
        length := GetScrap(phandle, 'PICT', offset);
        if length > 0 then begin
            ShowWatch;
            pframe := PicHandle(phandle)^^.PicFrame;
            with pframe do begin
                width := right - left;
                if odd(width) then
                    EvenWidth := width + 1
                else
                    EvenWidth := width;
                height := bottom - top;
                size := EvenWidth * height;
                if size > ClipBufSize then begin
                    PutError(StringOf('The ', size div 1024:1,'K image on the system clipboard is too large to paste.'));
                    DisposeHandle(phandle);
                    exit(ConvertFromSystemClipboard)
                end;
            end;
            with ClipBufInfo^ do begin
                PixelsPerLine := width;
                nlines := height;
                SetRect(PicRect, 0, 0, width, height);
                RoiRect := PicRect;
                RoiType := RectRoi;
                SaveGDevice := GetGDevice;
                SetGDevice(osGDevice);
                GetPort(tPort);
                SetPort(GrafPtr(osPif WhatsOnClip = textOnClip then
                        PasteText
                    else
                        beep;
                end;
        end;
    end;


    procedure DoClear;
        var
            fwptr: WindowPtr;
            kind: integer;
    begin
        fwptr := FrontWindow;
        if fwptr = nil then
            exit(DoClear);
        kind := WindowPeek(fwptr)^.WindowKind;
        if Kind = TextKind then begin
                DoTextClear;
                exit(DoClear);
            end;
        if not NoSelection then begin
                SetupUndo;
                WhatToUndo := UndoClear;
                CurrentOp := EraseOp;
                OpPending := true;
                RoiUpdateTime := 0;
            end;
    end;


    procedure ShowClipboard;
        var
            width, height, hstart, vstart, i, NewScrapCount: integer;
            okay:boolean;
    begin
        NewScrapCount := GetScrapCount;
        if NewScrapCount <> OldScrapCount then begin
                WhatsOnClip := NothingOnClip;
                OldScrapCount := NewScrapCount;
            end;
        if WhatsOnClip = NothingOnClip then
            ConvertFromSystemClipboard;
        if (WhatsOnClip = RectPic) or (WhatsOnClip = NonRectPic) or (WhatsOnClip = ImportedPic) or (WhatsOnClip = CameraPic) then
            with ClipBufinfo^.RoiRect do begin
                    width := right - left;
                    height := bottom - top;
                    if NewPicWindow('Clipboard', width, height) then begin
                            PastePicture;
                            KillRoi;
                            SetupUndo;
                            info^.changes := false;
                        end;
                end;
        if WhatsOnClip = TextOnClip then begin
            if MakeNewTextWindow('Clipboard', 400, 350) then
                DoTextPaste;
        end;
    end;


    function ScreenToPixmapH (hloc: integer): extended;
    begin
        with info^ do
            ScreenToPixmapH := SrcRect.left + hloc / magnification;
    end;

    function ScreenToPixmapV (vloc: integer): extended;
    begin
        with info^ do
            ScreenToPixmapV := SrcRect.top + vloc / magnification;
    end;


    procedure DoSelection (obj: ObjectType; start, finish: point);
        var
            tRect: rect;
            temp, StartH, StartV, FinishH, FinishV: integer;
            TempRgn: RgnHandle;
    begin
        WhatToUndo := NothingToUndo;
        Info^.RoiShowing := false;
        RoiUpdateTime := 0;
        if (start.h = finish.h) or (start.v = finish.v) then
            exit(DoSelection);
        if start.h > finish.h then begin
                temp := start.h;
                start.h := finish.h;
                finish.h := temp;
            end;
        if start.v > finish.v then begin
                temp := start.v;
                start.v := finish.v;
                finish.v := temp;
            end;
        StartH := round(ScreenToPixmapH(start.h));
        StartV := round(ScreenToPixmapV(start.v));
        FinishH := round(ScreenToPixmapH(finish.h));
        FinishV := round(ScreenToPixmapV(finish.v));
        SetRect(tRect, StartH, StartV, FinishH, FinishV);
        with info^ do begin
                RoiShowing := true;
                if SelectionMode <> NewSelection then
                    TempRgn := NewRgn;
                OpenRgn;
                case obj of
                    SelectionOval:  begin
                            FrameOval(tRect);
                            roiType := OvalRoi;
                        end;
                    SelectionRect:  begin
                            FrameRect(tRect);
                            roiType := RectRoi;
                        end;
                end;
                if SelectionMode = NewSelection then
                    CloseRgn(roiRgn)
                else begin
                        CloseRgn(TempRgn);
                        if RgnNotTooBig(roiRgn, TempRgn) then begin
                                if SelectionMode = AddSelection then
                                    UnionRgn(roiRgn, TempRgn, roiRgn)
                                else begin
                                        DiffRgn(roiRgn, TempRgn, roiRgn);
                                        UpdatePicWindow;
                                    end;
                            end;
                        DisposeRgn(TempRgn);
                        if GetHandleSize(handle(roiRgn)) = 10 then
                            roiType := RectRoi
                        else
                            roiType := FreehandRoi;
                        nCoordinates := 0;
                    end;
                RoiRect := roiRgn^^.rgnBBox;
            end;{with}
        measuring := false;
    end;


    procedure DoObject; {(obj: ObjectType; event: EventRecord)}
        var
            Start, Finish, ScreenStart, ScreenFinish, osStart, osFinish: point;
            r: rect;
            DeltaX, DeltaY, switch: integer;
            Constrain: boolean;
            StartH, StartV: extended;
    begin
        SetPort(info^.wptr);
        if obj = LineObj then
            DrawLabels('DX:', 'DY:', 'Length:')
        else
            DrawLabels('Width:', 'Height:', '');
        start := event.where;
        StartH := ScreenToPixmapH(start.h);
        StartV := ScreenToPixmapV(start.v);
        osStart := start;
        ScreenToOffscreen(osStart);
        finish := start;
        osFinish := finish;
        ScreenToOffscreen(osFinish);
        PenNormal;
        PenMode(PatXor);
        PenSize(1, 1);
        while button do begin
                GetMouse(finish);
                with finish, Info^ do begin
                        if h > wrect.right then
                            h := wrect.right;
                        if v > wrect.bottom then
                            v := wrect.bottom;
                        if h < 0 then
                            h := 0;
                        if v < 0 then
                            v := 0;
                    end;
                if ShiftKeyDown then begin
                        DeltaX := finish.h - start.h;
                        DeltaY := finish.v - start.v;
                        if obj = lineObj then begin
                                if abs(DeltaX) > abs(DeltaY) then
                                    finish.v := start.v
                                else
                                    finish.h := start.h
                            end
                        else begin
                                if ((DeltaX > 0) and (DeltaY < 0)) or ((DeltaX < 0) and (DeltaY > 0)) then
                                    switch := -1
                                else
                                    switch := 1;
                                if abs(DeltaX) > abs(DeltaY) then
                                    finish.h := start.h + switch * DeltaY
                                else
                                    finish.v := start.v + switch * DeltaX;
                            end;
                    end;
                osFinish := finish;
                ScreenToOffscreen(osfinish);
                case obj of
                    LineObj:  begin
                            MoveTo(start.h, start.v);
                            LineTo(finish.h, finish.v);
                            ShowDxDy(abs(ScreenToPixMapH(finish.h) - StartH), abs(ScreenToPixMapV(finish.v) - StartV));
                            MoveTo(start.h, start.v);
                            LineTo(finish.h, finish.v);
                        end;
                    Rectangle, SelectionRect:  begin
                            if obj = SelectionRect then begin
                                    PatIndex := (PatIndex + 1) mod 8;
                                    PenPat(AntPattern[PatIndex]);
                                end;
                            Pt2Rect(start, finish, r);
                            FrameRect(r);
                            Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1);
                            Pt2Rect(start, finish, r);
                            FrameRect(r);
                        end;
                    SelectionOval:  begin
                            PatIndex := (PatIndex + 1) mod 8;
                            PenPat(AntPattern[PatIndex]);
                            Pt2Rect(start, finish, r);
                            FrameOval(r);
                            Show3Values(osfinish.h - osstart.h, osfinish.v - osstart.v, -1);
                            Pt2Rect(start, finish, r);
                            FrameOval(r);
                        end;
                end; {case}
            end;  {while button}
        if (obj = SelectionRect) or (obj = SelectionOval) then begin
                DoSelection(obj, start, finish);
                exit(DoObject);
            end;
        if (obj = LineObj) and ((CurrentTool = LineTool) or (CurrentTool = PlotTool)) then begin
                MoveTo(start.h, start.v);
                LineTo(finish.h, finish.v);
                with info^ do begin
                        LX1 := StartH;
                        LY1 := StartV;
                        LX2 := ScreenToPixmapH(finish.h);
                        LY2 := ScreenToPixmapV(finish.v);
                        if LX1 > (PicRect.right - 1) then
                            LX1 := PicRect.right - 1;
                        if LY1 > (PicRect.bottom - 1) then
                            LY1 := PicRect.bottom - 1;
                        if LX1 < 0 then
                            LX1 := 0;
                        if LY1 < 0 then
                            LY1 := 0;
                        if LX2 > (PicRect.right - 1) then
                            LX2 := PicRect.right - 1;
                        if LY2 > (PicRect.bottom - 1) then
                            LY2 := PicRect.bottom - 1;
                        if LX2 < 0 then
                            LX2 := 0;
                        if LY2 < 0 then
                            LY2 := 0;
                    end;
                exit(DoObject);
            end;
        DrawObject(obj, start, finish);
    end;


    procedure DrawSprayCan (xcenter, ycenter: integer);
        var
            i, xoffset, yoffset, nDots: LongInt;
    begin
        nDots := SprayCanDiameter div 4;
        if nDots < 15 then
            nDots := 15;
        for i := 1 to nDots do begin
                repeat
                    xoffset := random mod SprayCanRadius;
                    yoffset := random mod SprayCanRadius;
                until xoffset * xoffset + yoffset * yoffset <= SprayCanRadius2;
                PutPixel(xcenter + xoffset, ycenter + yoffset, ForegroundIndex);
            end;
    end;


    procedure DoSprayCan;
  {Reference: "Spaying and Smudging", Dick Pountain, Byte, November 1987}
        var
            xcenter, ycenter, off: integer;
            MaskRect: rect;
            pt: point;
            SaveTicks:LongInt;
    begin
        info^.changes := true;
        off := SprayCanRadius;
        SaveTicks:=TickCount;
        repeat
            repeat until TickCount<>SaveTicks; {Update no more than 60 times per second}
            SaveTicks:=TickCount;
            GetMouse(pt);
            ScreenToOffscreen(pt);
            with MaskRect, pt do begin
                    left := h - off;
                    top := v - off;
                    right := h + off;
                    bottom := v + off;
                end;
            with pt do begin
                    xcenter := h;
                    ycenter := v
                end;
            DrawSprayCan(xcenter, ycenter);
            UpdateScreen(MaskRect);
        until not button;
        WhatToUndo := UndoEdit;
    end;


    procedure DoBrush; {(event: EventRecord)}
        var
            r, ScreenRect: rect;
            p1, p2, p2x, start: point;
            WhichWindow: WindowPtr;
            SaveLineWidth, SaveForegroundColor: integer;
            Constrained, MoreHorizontal, FirstTime: boolean;
            offset, width: integer;
            rWidth: double;
    begin
        SaveLineWidth := LineWidth;
        p1 := event.where;
        start := p1;
        if OptionKeyDown then begin
                case CurrentTool of
                    Brush, Pencil:
                        GetForegroundColor(event);
                    Eraser:
                        GetBackgroundColor(event);
                end;
                if (CurrentTool = Brush) or (CurrentTool = Eraser) then
                    exit(DoBrush);
            end;
        case CurrentTool of
            Pencil:
                LineWidth := 1;
            Brush, Eraser:  begin
                    if CurrentTool = Brush then
                        width := BrushWidth
                    else
                        width := 16;
                    LineWidth := round(width / info^.magnification);
                    if LineWidth < 1 then
                        LineWidth := 1;
                end;
        end;
        with info^ do
            rWidth := (LineWidth - 1) * info^.magnification / 2.0;
            offset := round(rWidth * 1.00000001);  {ppc-bug}
        if CurrentTool <> Pencil then
            with p1 do begin
                    h := h - offset;
                    v := v - offset
                end;
        Constrained := ShiftKeyDown;
        FirstTime := true;
        if CurrentTool = eraser then begin
                SaveForegroundColor := ForegroundIndex;
                SetForegroundColor(BackgroundIndex)
            end;
        repeat
            GetMouse(p2);
            if CurrentTool <> Pencil then
                with p2 do begin
                        h := h - offset;
                        v := v - offset
                    end;
            if FirstTime then
                if not EqualPt(p1, p2) then begin
                        MoreHorizontal := abs(p2.h - p1.h) >= abs(p2.v - p1.v);
                        FirstTime := false;
                    end;
            if Constrained then
                if MoreHorizontal then
                    p2.v := p1.v
                else
                    p2.h := p1.h;
            if CurrentTool = brush then
                DrawObject(BrushObj, p1, p2)
            else
                DrawObject(LineObj, p1, p2);
            p1 := p2;
        until not button;
        if CurrentTool = Eraser then
            SetForegroundColor(SaveForegroundColor);
        LineWidth := SaveLineWidth;
        WhatToUndo := UndoEdit;
    end;


    procedure DrawCharacter; {(ch: char)}
        var
            str: str255;
    begin
        if Info = NoInfo then begin
                beep;
                exit(DrawCharacter)
            end;
        if ch = cr then
            with InsertionPoint do begin
                    h := TextStart.h;
                    v := v + CurrentSize;
                    SetupUndo;
                    TextStr := '';
                    TextStart := InsertionPoint;
                    exit(DrawCharacter)
                end;
        if ch = BackSpace then
            with InsertionPoint do begin
                    if length(TextStr) > 0 then begin
                            delete(TextStr, length(TextStr), 1);
                            DisplayText(true);
                        end;
                    exit(DrawCharacter)
                end;
        str := ' '; {Needed for MPW}
        str[1] := ch;
        TextStr := Concat(TextStr, str);
        DisplayText(true);
    end;


    procedure DoText; {(loc: point)}
  {Handles text tool mouse clicks.}
        var
            value: extended;
            str: str255;
            isValue: boolean;
    begin
        if NoUndo then
            exit(DoText);
        ScreenToOffscreen(loc);
        with loc do begin
                InsertionPoint.h := h;
                InsertionPoint.v := v + 4;
            end;
        IsInsertionPoint := true;
        TextStart := InsertionPoint;
        TextStr := '';
        if OptionKeyDown then
            with info^ do begin
                    isValue := true;
                    if (PreviousTool = LineTool) and (nLengths > 0) then
                        value := plength^[mCount2]
                    else if (PreviousTool = AngleTool) and (nAngles > 0) then
                        value := orientation^[mCount2]
                    else if mCount > 0 then
                        if AreaM in Measurements then
                            value := mArea^[mCount2]
                        else if MeanM in Measurements then
                            value := mean^[mCount2]
                        else
                            isValue := false;
                    if isValue then begin
                            RealToString(value, 1, precision, str);
                            if mCount2 > 0 then
                                mCount2 := mCount2 - 1;
                            DrawTextString(str, TextStart, TextJust);
                        end;
                end;
        WhatToUndo := UndoEdit;
    end;


    procedure DoFill (event: EventRecord);
        var
            loc: point;
            MaskBits: BitMap;
            BitMapSize: LongInt;
            tPort: GrafPtr;
            trect: rect;
            SaveGDevice: GDHandle;
    begin
        ShowWatch;
        loc := event.where;
        ScreenToOffscreen(loc);
        with info^ do begin
                tRect := PicRect;
                with tRect do
                    if (right mod 16 <> 0) and not Has32BitQuickDraw then
                        right := (right div 16) * 16 + 16;  {Workaround for SeedCFill bug that results in  garbage along right edge.}
                with MaskBits do begin
                        RowBytes := PixelsPerLine div 8 + 1;
                        if odd(RowBytes) then
                            RowBytes := RowBytes + 1;
                        bounds := tRect;
                        BitMapSize := rowBytes * nLines;
                        baseAddr := NewPtr(BitMapSize);
                        if baseAddr = nil then begin
                                beep;
                                exit(DoFill)
                            end;
                    end;
                SaveGDevice := GetGDevice;
                SetGDevice(osGDevice);
                GetPort(tPort);
                SetPort(GrafPtr(osPort));
                pmForeColor(ForegroundIndex);
                SeedCFill(BitMapHandle(osPort^.PortPixMap)^^, MaskBits, tRect, tRect, loc.h, loc.v, nil, 0);
                CopyBits(MaskBits, BitMapHandle(osPort^.PortPixMap)^^, tRect, tRect, SrcOr, nil);
                DisposePtr(MaskBits.baseAddr);
                changes := true;
            end; {with}
        SetPort(tPort);
        SetGDevice(SaveGDevice);
        UpdatePicWindow;
        WhatToUndo := UndoEdit;
    end;


    procedure SetSprayCanSize;
        var
            TempSize: integer;
            Canceled: boolean;
    begin
        TempSize := GetInt('Spray can diameter in pixels(2-250):', SprayCanDiameter, Canceled);
        if Canceled then
            exit(SetSprayCanSize);
        if (TempSize > 1) and (TempSize <= 250) then begin
                SprayCanDiameter := TempSize;
                SprayCanRadius := SprayCanDiameter div 2;
                SprayCanRadius2 := SprayCanRadius * SprayCanRadius
            end
        else
            beep;
    end;


    procedure SetBrushSize;
        var
            TempSize: integer;
            Canceled: boolean;
            i, ticks, x, y: LongInt;
            v: integer;
    begin
        TempSize := GetInt('Brush Size in pixels(1..99):', BrushWidth, Canceled);
        if Canceled then
            exit(SetBrushSize);
        if (TempSize > 0) and (TempSize < 100) then begin
                BrushWidth := TempSize;
                BrushHeight := BrushWidth
            end
        else
            beep;
{exit(SetBrushSize);}
    {Timer}
        x := 100;
        y := 100;
        ticks := TickCount;
        for i := 1 to 1000000 do
            v := MyGetPixel(x, y);
        ShowMessage(concat('ticks=', long2str(TickCount - ticks)));
    end;


    procedure SetLineWidth;
        var
            TempSize: integer;
            Canceled: boolean;
    begin
        TempSize := GetInt('Line Width in pixels(1..100):', LineWidth, Canceled);
        if Canceled then
            exit(SetLineWidth);
        if (TempSize > 0) and (TempSize <= 100) then begin
                LineWidth := TempSize;
                ShowLineWidth;
            end
        else
            beep;
    end;


    procedure FindWhatToCopy;
        var
            kind: integer;
            WhichWindow: WindowPtr;
    begin
        WhatToCopy := NothingToCopy;
        WhichWindow := FrontWindow;
        if WhichWindow = nil then
            exit(FindWhatToCopy);
        kind := WindowPeek(WhichWindow)^.WindowKind;
        if (CurrentTool = PickerTool) and (kind <> TextKind) then
            WhatToCopy := CopyColor
        else begin
                if (kind = PicKind) and measuring and (not macro) then
                    kind := ResultsKind;
                case kind of
                    PicKind:
                        with info^, info^.RoiRect do
                            if RoiShowing and (left >= 0) and (top >= 0) and (right <= PicRect.right) and (bottom <= PicRect.bottom) then
                                WhatToCopy := CopySelection;
                    HistoKind:
                        WhatToCopy := CopyHistogram;
                    ProfilePlotKind:
                        WhatToCopy := CopyPlot;
                    CalibrationPlotKind:
                        WhatToCopy := CopyCalibrationPlot;
                    LUTKind:
                        if info <> NoInfo then
                            WhatToCopy := CopyCLUT;
                    MapKind:
                        if info <> NoInfo then
                            WhatToCopy := CopyGrayMap;
                    ToolKind:
                        WhatToCopy := CopyTools;
                    TextKind:  begin
                            TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
                            if TextInfo <> nil then
                                with TextInfo^.TextTE^^ do
                                    if selEnd > selStart then
                                        WhatToCopy := CopyText;
                        end;
                    InfoKind, ResultsKind:
                        if mCount > 0 then
                            WhatToCopy := CopyMeasurements;
                    otherwise
                end;
            end;
    end;


    procedure UpdateEditMenu;
        var
            DimUndo, ShowItems: boolean;
            str: str255;
            i: integer;
    begin
        with info^ do begin
                if CurrentKind < 0 then begin   {DA is active, so activate Edit menu.}
                        SetMenuItemText(EditMenuH, UndoItem, 'Undo');
                        SetMenuItemText(EditMenuH, CutItem, 'Cut');
                        SetMenuItemText(EditMenuH, CopyItem, 'Copy');
                        SetMenuItem(EditMenuH, UndoItem, true);
                        for i := CutItem to ClearItem do
                            SetMenuItem(EditMenuH, i, true);
                        exit(UpdateEditMenu);
                    end;
                if not (WhatToUndo in [UndoLUT, UndoMeasurement, UndoPoint]) and ((info = NoInfo) or (PixMapSize <> CurrentUndoSize)) then
                    WhatToUndo := NothingToUndo;
                DimUndo := WhatToUndo = NothingToUndo;
                SetMenuItem(EditMenuH, UndoItem, not DimUndo);
                if DimUndo then
                    SetMenuItemText(EditMenuH, UndoItem, 'Undo');
                case WhatToUndo of
                    UndoEdit:
                        str := 'Editing';
                    UndoFlip:
                        str := 'Flip';
                    UndoRotate:
                        str := 'Rotate';
                    UndoFilter:
                        str := 'Filter';
                    UndoPaste:
                        str := 'Paste';
                    UndoMeasurement, UndoPoint:
                        str := 'Measurement';
                    UndoTransform:
                        str := 'Transformation';
                    UndoClear:
                        str := 'Clear';
                    UndoZoom:
                        str := 'Zoom';
                    UndoOutline:
                        str := 'Outline';
                    UndoSliceDelete, UndoFirstSliceDelete:
                        str := 'Delete Slice';
                    UndoLUT:
                        str := 'LUT Change';
                    otherwise
                        str := '';
                end;
                SetMenuItemText(EditMenuH, UndoItem, concat('Undo ', str));
                FindWhatToCopy;
                if WhatToCopy = CopySelection then
                    str := 'Cut Selection'
                else
                    str := 'Cut';
                SetMenuItemText(EditMenuH, CutItem, str);
                SetMenuItem(EditMenuH, CutItem, (WhatToCopy = CopySelection) or (WhatToCopy = CopyText));
                case WhatToCopy of
                    NothingToCopy, CopyText:
                        str := '';
                    CopySelection:
                        str := 'Selection';
                    CopyCLUT:
                        str := 'LUT';
                    CopyGrayMap:
                        str := 'Gray Map';
                    CopyTools:
                        str := 'Tools';
                    CopyPlot:
                        str := 'Plot';
                    CopyCalibrationPlot:
                        str := 'Calibration Plot';
                    CopyHistogram:
                        str := 'Histogram';
                    CopyMeasurements:
                        str := 'Measurements';
                    CopyColor:
                        str := 'Color';
                end;
                SetMenuItemText(EditMenuH, CopyItem, concat('Copy ', str));
                SetMenuItem(EditMenuH, CopyItem, WhatToCopy <> NothingToCopy);
                SetMenuItem(EditMenuH, ClearItem, (WhatToCopy = CopySelection) or (WhatToCopy = CopyText));
                ShowItems := (WhatsOnClip <> NothingOnClip) or (OldScrapCount <> GetScrapCount);
                SetMenuItem(EditMenuH, PasteItem, ShowItems);
                SetMenuItem(EditMenuH, ShowClipboardItem, ShowItems);
                ShowItems := info <> NoInfo;
                if CurrentKind = TextKind then
                    SetMenuItemText(EditMenuH, FillItem, 'Find…')
                else
                    SetMenuItemText(EditMenuH, FillItem, 'Fill');
                SetMenuItem(EditMenuH, FillItem, ShowItems or (CurrentKind = TextKind));
                SetMenuItem(EditMenuH, InvertItem, ShowItems);
                SetMenuItem(EditMenuH, DrawBoundaryItem, ShowItems);
                SetMenuItem(EditMenuH, DrawScaleItem, ShowItems);
                if (RoiShowing and EqualRect(RoiRect, PicRect)) and (CurrentKind <> TextKind) then
                    SetMenuItemText(EditMenuH, SelectAllItem, 'Deselect All')
                else
                    SetMenuItemText(EditMenuH, SelectAllItem, 'Select All');
                SetMenuItem(EditMenuH, SelectAllItem, ShowItems or (CurrentKind = TextKind));
                SetMenuItem(EditMenuH, DeselectItem, ShowItems and RoiShowing);
                SetMenuItem(EditMenuH, ScaleAndRotateItem, ShowItems);
                for i := RotateLeftItem to FlipHorizontalItem do
                    SetMenuItem(EditMenuH, i, ShowItems);
                SetMenuItem(EditMenuH, UnZoomItem, ShowItems and ((magnification <> 1.0) or ScaleToFitWindow));
            end; {with}
    end;


    procedure ZoomOut;
        var
            Width, Height, divisor, NewWidth, NewHeight: integer;
            OldMagnification, xratio, yratio: extended;
    begin
        with Info^ do begin
                if magnification < 2.0 then begin
                        beep;
                        exit(ZoomOut)
                    end;
                OldMagnification := magnification;
                if magnification = 2.0 then begin
                        magnification := 1.0;
                        divisor := 4
                    end
                else if magnification = 3.0 then begin
                        magnification := 2.0;
                        divisor := 6
                    end
                else if magnification = 4.0 then begin
                        magnification := 3.0;
                        divisor := 8
                    end
                else begin
                        magnification := magnification / 2.0;
                        divisor := 4
                    end;
                if EqualRect(SrcRect, PicRect) then begin {Make window smaller}
                        NewWidth := trunc(PicRect.right * magnification);
                        NewHeight := trunc(PicRect.bottom * magnification);
                        SizeWindow(wptr, NewWidth, NewHeight, true);
                        wrect.right := NewWidth;
                        wrect.bottom := NewHeight;
                        SrcRect := PicRect;
                        UpdateTitleBar;
                        UpdatePicWindow;
                        DrawMyGrowIcon(wptr);
                        exit(ZoomOut);
                    end;
                if ((wrect.right > PicRect.right) or (wrect.bottom > PicRect.bottom)) then begin
                        xratio := wrect.right / PicRect.right;
                        yratio := wrect.bottom / PicRect.bottom;
                        if (xratio <> yratio) or ((xratio - trunc(xratio)) <> 0.0) then begin
                                UnZoom;
                                Exit(ZoomOut)
                            end;
                        SrcRect := PicRect;
                        Magnification := xratio;
                        UpdateTitleBar;
                        UpdatePicWindow;
                        DrawMyGrowIcon(wptr);
                        Exit(ZoomOut)
                    end;
            end; {with}
        with Info^.SrcRect, info^ do begin
                if magnification = 1.0 then begin
                        width := wrect.right;
                        height := wrect.bottom;
                    end
                else begin
                        width := round((right - left) * OldMagnification / Magnification);
                        height := round((bottom - top) * OldMagnification / Magnification);
                    end;
                left := left - (width div divisor);
                if left < 0 then
                    left := 0;
                if (left + width) > Info^.PicRect.right then
                    left := Info^.PicRect.right - width;
                top := top - (height div divisor);
                if top < 0 then
                    top := 0;
                if (top + height) > Info^.PicRect.bottom then
                    top := Info^.picRect.bottom - height;
                right := left + width;
                bottom := top + height;
                RoiShowing := false;
                UpdatePicWindow;
                DrawMyGrowIcon(wptr);
                UpdateTitleBar;
            end;
        ShowRoi;
    end;


    procedure DoGrow; {(WhichWindow: WindowPtr; event: EventRecord)}
        var
            NewSize: LongInt;
            trect, WinRect, SizeRect: rect;
            kind: integer;
            WasDigitizing: boolean;
            ZoomCenterH, ZoomCenterV, width, height: extended;
    begin
        kind := WindowPeek(WhichWindow)^.WindowKind;
        if kind = PicKind then
            with info^, SizeRect do begin
                    if ScaleToFitWindow then
                        SizeRect := qd.ScreenBits.bounds
                    else begin
                            right := PicRect.right + 1;
                            bottom := PicRect.bottom + 1;
                            if magnification > 1.0 then begin
                                    right := round(right * magnification);
                                    bottom := round(bottom * magnification);
                                end;
                            left := 32;
                            top := 32;
                            if left > right then
                                left := right;
                            if top > bottom then
                                top := bottom;
                        end
                end
        else
            SetRect(SizeRect, 64, 48, 2048, 2048);
        NewSize := GrowWindow(WhichWindow, event.where, SizeRect);
        if newSize = 0 then
            exit(DoGrow);
        if kind = PicKind then
            with Info^ do begin
                    SetPort(wptr);
                    WasDigitizing := digitizing;
                    StopDigitizing;
                    InvalRect(wrect);
                    with trect do begin
                            top := 0;
                            left := 0;
                            right := LoWrd(NewSize);
                            bottom := HiWrd(NewSize);
                        end;
                    if ScaleToFitWindow then begin
                            ScaleImageWindow(trect);
                            wrect := trect;
                        end
                    else begin
                            if trect.right > PicRect.right * magnification then
                                trect.right := trunc(PicRect.right * magnification);
                            if trect.bottom > PicRect.bottom * magnification then
                                trect.bottom := trunc(PicRect.bottom * magnification);
                            wrect := trect;
                            with SrcRect do begin
                                    ZoomCenterH := left + (wrect.right / 2.0) / magnification;
                                    ZoomCenterV := top + (wrect.bottom / 2.0) / magnification;
                                    width := wrect.right / magnification;
                                    height := wrect.bottom / magnification;
                                    left := round(ZoomCenterH - width / 2.0);
                                    if left < 0 then
                                        left := 0;
                                    if (left + width) > PicRect.right then
                                        left := round(PicRect.right - width);
                                    top := round(ZoomCenterV - height / 2.0);
                                    if top < 0 then
                                        top := 0;
                                    if (top + height) > PicRect.bottom then
                                        top := round(picRect.bottom - height);
                                    right := round(left + width);
                                    bottom := round(top + height);
                                    wrect.right := trunc((right - left) * magnification);
                                    wrect.bottom := trunc((bottom - top) * magnification);
                                end;
                            savewrect := wrect;
                        end;
                    SizeWindow(WhichWindow, wrect.right, wrect.bottom, true);
                    WindowState := NormalWindow;
                    if WasDigitizing then
                        StartDigitizing;
                    exit(DoGrow)
                end; {with info^}
        if WhichWindow = PlotWindow then begin
                PlotWidth := LoWrd(NewSize);
                PlotHeight := HiWrd(NewSize);
                SetPort(PlotWindow);
                SizeWindow(PlotWindow, PlotWidth, Plotheight, true);
                InvalRect(PlotWindow^.PortRect);
                exit(DoGrow)
            end;
        if (kind = TextKind) then begin
                TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon);
                GrowTextWindow(NewSize);
                exit(DoGrow)
            end;
        if WhichWindow = ResultsWindow then begin
                ResultsWidth := LoWrd(NewSize);
                ResultsHeight := HiWrd(NewSize);
                SetPort(ResultsWindow);
                with ResultsWindow^.PortRect do
                    SetRect(tRect, right - 12, bottom - 12, right, bottom);
                EraseRect(trect); {Erase Grow Box}
                SizeWindow(ResultsWindow, ResultsWidth, ResultsHeight, true);
                MoveControl(hScrollBar, -1, ResultsHeight - ScrollBarWidth);
                MoveControl(vScrollBar, ResultsWidth - ScrollBarWidth, -1);
                SizeControl(hScrollBar, ResultsWidth - 13, ScrollBarWidth + 1);
                SizeControl(vScrollBar, ScrollBarWidth + 1, ResultsHeight - 13);
                InvalRect(ResultsWindow^.PortRect);
                with ListTE^^.viewRect do begin
                        right := left + ResultsWidth - ScrollBarWidth - 4;
                        bottom := top + ResultsHeight - ScrollBarWidth;
                    end;
                UpdateResultsScrollBars;
                ScrollResultsText;
            end;
    end;


    procedure ZoomIn; {(event: EventRecord)}
        var
            width, height, OldMagnification: extended;
            PicCenterH, PicCenterV, NewWidth, NewHeight: integer;
            trect: rect;
    begin
        if Info = NoInfo then begin
                beep;
                exit(ZoomIn)
            end;
        if Info^.ScaleToFitWindow then begin
                PutError('The magnifying glass does not work in "Scale to Fit Window" mode.');
                exit(ZoomIn)
            end;
        if BitAnd(Event.modifiers, OptionKey) = OptionKey then begin
                ZoomOut;
                WhatToUndo := NothingToUndo;
                exit(ZoomIn)
            end;
        with Info^ do begin
                OldMagnification := magnification;
                if magnification = 1.0 then
                    magnification := 2.0
                else if magnification = 2.0 then
                    magnification := 3.0
                else if magnification = 3.0 then
                    magnification := 4.0
                else begin
                        magnification := magnification * 2.0;
                        if magnification > 64.0 then begin
                                magnification := 64.0;
                                exit(ZoomIn)
                            end;
                    end;
                if (WindowState = NormalWindow) and EqualRect(SrcRect, PicRect) then {Make window bigger?}
                    with trect do begin
                            NewWidth := trunc(PicRect.right * magnification);
                            NewHeight := trunc(PicRect.bottom * magnification);
                            if NewWidth <= 640 then begin
                                    GetWindowRect(wptr, trect);
                                    if ((left + NewWidth) <= ScreenWidth) and ((top + NewHeight) <= ScreenHeight) then begin
                                            SizeWindow(wptr, NewWidth, NewHeight, true);
                                            wrect.right := NewWidth;
                                            wrect.bottom := NewHeight;
                                        end;
                                end;
                        end;
            end; {with}
        with Info^.SrcRect, Info^ do begin
                PicCenterH := left + round(event.where.h / OldMagnification);
                PicCenterV := top + round(event.where.v / OldMagnification);
                width := wrect.right / magnification;
                height := wrect.bottom / magnification;
                left := PicCenterH - round(width / 2.0);
                if left < 0 then
                    left := 0;
                if (left + width) > PicRect.right then
                    left := PicRect.right - round(width);
                top := PicCenterV - round(height / 2.0);
                if top < 0 then
                    top := 0;
                if (top + height) > PicRect.bottom then
                    top := picRect.bottom - round(height);
                right := left + round(width);
                bottom := top + round(height);
                wrect.right := trunc((right - left) * magnification);
                wrect.bottom := trunc((bottom - top) * magnification);
                SizeWindow(wptr, wrect.right, wrect.bottom, true);
                RoiShowing := false;
                UpdatePicWindow;
                DrawMyGrowIcon(wptr);
                UpdateTitleBar;
                WhatToUndo := UndoZoom;
                ShowRoi;
            end; {with}
    end;


    procedure SynchScroll;
        var
            n: integer;
            TempInfo, SaveInfo: InfoPtr;
    begin
        SaveInfo := info;
        if allsamesize then
            for n := 1 to nPics do begin
                    TempInfo := pointer(WindowPeek(PicWindow[n])^.RefCon);
                    TempInfo^.SrcRect := info^.SrcRect;
                    TempInfo^.magnification := Info^.magnification;
                    info := TempInfo;
                    UpdatePicWindow;
                    Info := SaveInfo;
                end
        else
            PutError('Synchronized scrolling requires all images and all windows to be the same size.');
    end;


    procedure Scroll; {(event: EventRecord)}
        var
            hstart, vstart, DeltaH, DeltaV, width, height: integer;
            loc: point;
            SaveSR: rect;
            WasDigitizing: boolean;
    begin
        with info^ do begin
                if ScaleToFitWindow then begin
                        PutError('Scrolling does not work in "Scale to Fit Window" mode.');
                        exit(Scroll)
                    end;
                WasDigitizing := digitizing;
                StopDigitizing;
                with event.where do begin
                        hstart := h;
                        vstart := v
                    end;
                with SrcRect do begin
                        width := right - left;
                        height := bottom - top
                    end;
                SaveSR := SrcRect;
                while StillDown do begin
                        GetMouse(loc);
                        DeltaH := hstart - loc.h;
                        DeltaV := vstart - loc.v;
                        with SrcRect do begin
                                left := SaveSR.left + DeltaH;
                                if left < 0 then
                                    left := 0;
                                if (left + width) > PicRect.right then
                                    left := PicRect.right - width;
                                right := left + width;
                                top := SaveSR.top + DeltaV;
                                if top < 0 then
                                    top := 0;
                                if (top + height) > PicRect.bottom then
                                    top := PicRect.bottom - height;
                                bottom := top + height;
                            end;
                        UpdatePicWindow;
                        DrawMyGrowIcon(wptr);
                    end;
                WhatToUndo := NothingToUndo;
                ShowRoi;
                if OptionKeyDown and (nPics > 1) then
                    SynchScroll;
                if WasDigitizing then
                    StartDigitizing;
            end; {with info^}
    end;


    procedure ConverToSystemClipboard;
    {Converts local clipboard to system-wide clipboard}
    {when quitting or switching to other programs.}
    var
        PicH: PicHandle;
        err: LongInt;
        saveClipRgn: RgnHandle;
    begin
        PicH := nil;
        if ((WhatsOnClip = RectPic) or (WhatsOnClip = CameraPic)) and (ClipBuf <> nil) and not ClipboardConverted then
            with ClipBufInfo^ do begin
                ShowWatch;
                SetPort(GrafPtr(osPort));
                saveClipRgn := NewRgn;
                GetClip(saveClipRgn);
                ClipRect(RoiRect);
                LoadLUT(ctable);  {Switch to original LUT}
                RGBForeColor(BlackRGB);
                RGBBackColor(WhiteRGB);
                PicH := OpenPicture(RoiRect);
                with osPort^ do
                    CopyBits(BitMapHandle(portPixMap)^^, BitMapHandle(portPixMap)^^, RoiRect, RoiRect, SrcCopy, nil);
                ClosePicture;
                if info <> NoInfo then
                    LoadLUT(info^.ctable); {Restore LUT}
                if (PicH <> nil) or ClipTextInBuffer then begin
                        err := ZeroScrap;
                        if err = NoErr then begin
                            if PicH <> nil then begin
                                hlock(handle(PicH));
                                err := PutScrap(GetHandleSize(handle(PicH)), 'PICT', handle(PicH)^);
                                hunlock(handle(PicH));
                                DisposeHandle(handle(PicH));
                            end;
                            if (err = noErr) and ClipTextInBuffer then
                                err := PutScrap(TextBufSize, 'TEXT', ptr(TextBufP));
                        end; {if err=NoErr}
                    end;
                ClipboardConverted := true;
                SetClip(saveClipRgn);
                DisposeRgn(saveClipRgn);
            end; {with}
    end;


    procedure SetupOperation; {(item: integer)}
        var
            AutoSelectAll: boolean;
    begin
        if NotinBounds then
            exit(SetupOperation);
        if item = DrawBoundaryItem then
            if NoSelection then
                exit(SetupOperation);
        if item = InvertItem then
            if not CheckCalibration then
                exit(SetupOperation);
        StopDigitizing;
        AutoSelectAll := not Info^.RoiShowing;
        if AutoSelectAll then
            SelectAll(true);
        SetupUndo;
        WhatToUndo := UndoEdit;
        case Item of
            FillItem:  begin
                    CurrentOp := PaintOp;
                    OpPending := true
                end;
            InvertItem:  begin
                    CurrentOp := InvertOp;
                    OpPending := true
                end;
            DrawBoundaryItem:  begin
                    CurrentOp := FrameOp;
                    OpPending := true
                end;
        end;
        if AutoSelectAll then
            KillRoi;
        RoiUpdateTime := 0; {Forces outline to be redrawn in scale-to-fit mode.}
    end;


    procedure DoUndo;
        var
            aok: boolean;
    begin
        case WhatToUndo of
            UndoMeasurement:
                UndoLastMeasurement(true);
            UndoPoint:  begin
                    Undo;
                    UpdatePicWindow;
                    UndoLastMeasurement(true);
                    WhatToUndo := NothingToUndo;
                end;
            UndoZoom:  begin
                    ZoomOut;
                    if info^.magnification < 2 then
                        WhatToUndo := NothingToUndo;
                end;
            UndoOutLine:  begin
                    undo;
                    if WandAutoMeasure then
                        UndoLastMeasurement(true);
                    WhatToUndo := NothingToUndo;
                    UpdatePicWindow;
                end;
            UndoSliceDelete, UndoFirstSliceDelete:
                if info^.StackInfo <> nil then
                    with info^.StackInfo^ do begin
                            if WhatToUndo = UndoFirstSliceDelete then
                                CurrentSlice := 0;
                            aok := AddSlice(false);
                            if aok then begin
                                    Undo;
                                    UpdatePicWindow;
                                end
                            else if CurrentSlice = 0 then
                                CurrentSlice := 1;
                        end;
            UndoLUT:  begin
                    UndoLutChange;
                    DrawMap;
                    DensitySlicing := false;
                end;
            otherwise begin
                    if UndoFromClip then
                        OpPending := false;
                    if not OpPending then
                        undo;
                    WhatToUndo := NothingToUndo;
                    if IsInsertionPoint then begin
                            InsertionPoint := TextStart;
                            TextStr := '';
                        end;
                    UpdatePicWindow;
                    if OpPending and (CurrentOp = PasteOp) then begin
                            OpPending := false;
                            KillRoi;
                        end;
                    OpPending := false;
                end;
        end; {case}
    end;



end.